home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / text-circle.scm < prev    next >
Text File  |  2009-12-15  |  7KB  |  221 lines
  1. ;; text-circle.scm -- a script for GIMP
  2. ;; Author: Shuji Narazaki <narazaki@gimp.org>
  3. ;; Time-stamp: <1998/11/25 13:26:51 narazaki@gimp.org>
  4. ;; Version 2.5
  5. ;; Thanks:
  6. ;;   jseymour@jimsun.LinxNet.com (Jim Seymour)
  7. ;;   Sven Neumann <neumanns@uni-duesseldorf.de>
  8. ;;
  9. ;; Modified June 24, 2005 by Kevin Cozens
  10. ;; Incorporated changes made by Daniel P. Stasinski in his text-circle2.scm
  11. ;; script. The letters are now placed properly for both positive and negative
  12. ;; fill angles.
  13.  
  14. (if (not (symbol-bound? 'script-fu-text-circle-debug? (current-environment)))
  15.     (define script-fu-text-circle-debug? #f)
  16. )
  17.  
  18. (define (script-fu-text-circle text radius start-angle fill-angle
  19.                                font-size antialias font-name)
  20.  
  21.   (define (wrap-string str)
  22.     (string-append "\"" str "\"")
  23.   )
  24.   (define (white-space-string? str)
  25.     (or (equal? " " str) (equal? "\t" str))
  26.   )
  27.  
  28.   (let* (
  29.         (drawable-size (* 2.0 (+ radius (* 2 font-size))))
  30.         (script-fu-text-circle-debug? #f)
  31.         (img (car (gimp-image-new drawable-size drawable-size RGB)))
  32.         (BG-layer (car (gimp-layer-new img drawable-size drawable-size
  33.                        RGBA-IMAGE "background" 100 NORMAL-MODE)))
  34.         (merged-layer #f)
  35.         (char-num (string-length text))
  36.         (radian-step 0)
  37.         (rad-90 (/ *pi* 2))
  38.         (center-x (/ drawable-size 2))
  39.         (center-y center-x)
  40.         (font-infos (gimp-text-get-extents-fontname "lAgy" font-size
  41.                                 PIXELS font-name))
  42.         (desc (nth 3 font-infos))
  43.         (start-angle-rad (* (/ (modulo start-angle 360) 360) 2 *pi*))
  44.         (angle-list #f)
  45.         (letter "")
  46.         (new-layer #f)
  47.         (index 0)
  48.         (ndx 0)
  49.         (ndx-start 0)
  50.         (ndx-step 1)
  51.         (ccw 0)
  52.         (fill-angle-rad 0)
  53.         (rot-op 0)
  54.         (radian-step 0)
  55.         )
  56.  
  57.     (gimp-image-undo-disable img)
  58.     (gimp-image-add-layer img BG-layer 0)
  59.     (gimp-edit-fill BG-layer BACKGROUND-FILL)
  60.  
  61.     ;; change units
  62.     (if (< fill-angle 0)
  63.         (begin
  64.           (set! ccw 1)
  65.           (set! fill-angle (abs fill-angle))
  66.           (set! start-angle-rad (* (/ (modulo (+ (- start-angle fill-angle) 360) 360) 360) 2 *pi*))
  67.           (set! ndx-start (- char-num 1))
  68.           (set! ndx-step -1)
  69.         )
  70.     )
  71.  
  72.     (set! fill-angle-rad (* (/ fill-angle 360) 2 *pi*))
  73.     (set! radian-step (/ fill-angle-rad char-num))
  74.  
  75.     ;; make width-list
  76.     ;;  In a situation,
  77.     ;; (car (gimp-drawable-width (car (gimp-text ...)))
  78.     ;; != (car (gimp-text-get-extent ...))
  79.     ;; Thus, I changed to gimp-text from gimp-text-get-extent at 2.2 !!
  80.     (let (
  81.          (temp-list '())
  82.          (temp-str #f)
  83.          (temp-layer #f)
  84.          (scale 0)
  85.          (temp #f)
  86.          )
  87.       (set! ndx ndx-start)
  88.       (set! index 0)
  89.       (while (< index char-num)
  90.         (set! temp-str (substring text ndx (+ ndx 1)))
  91.         (if (white-space-string? temp-str)
  92.             (set! temp-str "x")
  93.         )
  94.         (set! temp-layer (car (gimp-text-fontname img -1 0 0
  95.                               temp-str
  96.                               1 antialias
  97.                               font-size PIXELS
  98.                               font-name)))
  99.         (set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list))
  100.         (gimp-image-remove-layer img temp-layer)
  101.         (set! ndx (+ ndx ndx-step))
  102.         (set! index (+ index 1))
  103.       )
  104.       (set! angle-list (nreverse temp-list))
  105.       (set! temp 0)
  106.       (set! angle-list
  107.         (mapcar
  108.           (lambda (angle)
  109.             (let ((tmp temp))
  110.               (set! temp (+ angle temp))
  111.               (+ tmp (/ angle 2))
  112.             )
  113.           )
  114.           angle-list
  115.         )
  116.       )
  117.       (set! scale (/ fill-angle-rad temp))
  118.       (set! angle-list (mapcar (lambda (angle) (* scale angle)) angle-list))
  119.     )
  120.     (set! ndx ndx-start)
  121.     (set! index 0)
  122.     (while (< index char-num)
  123.       (set! letter (substring text ndx (+ ndx 1)))
  124.       (if (not (white-space-string? letter))
  125.         ;; Running gimp-text with " " causes an error!
  126.         (let* (
  127.               (new-layer (car (gimp-text-fontname img -1 0 0
  128.                                        letter
  129.                                        1 antialias
  130.                                        font-size PIXELS
  131.                                        font-name)))
  132.               (width (car (gimp-drawable-width new-layer)))
  133.               (height (car (gimp-drawable-height new-layer)))
  134.               (rotate-radius (- (/ height 2) desc))
  135.               (angle (+ start-angle-rad (- (nth index angle-list) rad-90)))
  136.               )
  137.  
  138.           (gimp-layer-resize new-layer width height 0 0)
  139.           (set! width (car (gimp-drawable-width new-layer)))
  140.           (if (not script-fu-text-circle-debug?)
  141.             (begin
  142.               (if (= ccw 0)
  143.                   (set! rot-op (if (< 0 fill-angle-rad) + -))
  144.                   (set! rot-op (if (> 0 fill-angle-rad) + -))
  145.               )
  146.               (gimp-drawable-transform-rotate-default new-layer
  147.                        (rot-op angle rad-90)
  148.                        TRUE 0 0
  149.                        TRUE FALSE)
  150.               (gimp-layer-translate new-layer
  151.                    (+ center-x
  152.                       (* radius (cos angle))
  153.                       (* rotate-radius
  154.                          (cos (if (< 0 fill-angle-rad)
  155.                                   angle
  156.                                   (+ angle *pi*)
  157.                               )
  158.                          )
  159.                       )
  160.                       (- (/ width 2))
  161.                    )
  162.                    (+ center-y
  163.                       (* radius (sin angle))
  164.                       (* rotate-radius
  165.                          (sin (if (< 0 fill-angle-rad)
  166.                                   angle
  167.                                   (+ angle *pi*)
  168.                               )
  169.                          )
  170.                       )
  171.                       (- (/ height 2))
  172.                    )
  173.               )
  174.             )
  175.           )
  176.         )
  177.       )
  178.       (set! ndx (+ ndx ndx-step))
  179.       (set! index (+ index 1))
  180.     )
  181.  
  182.     (gimp-drawable-set-visible BG-layer 0)
  183.     (if (not script-fu-text-circle-debug?)
  184.       (begin
  185.         (set! merged-layer
  186.                 (car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
  187.         (gimp-drawable-set-name merged-layer
  188.                      (if (< (string-length text) 16)
  189.                          (wrap-string text)
  190.                          "Text Circle"
  191.                      )
  192.         )
  193.       )
  194.     )
  195.     (gimp-drawable-set-visible BG-layer 1)
  196.     (gimp-image-undo-enable img)
  197.     (gimp-image-clean-all img)
  198.     (gimp-display-new img)
  199.     (gimp-displays-flush)
  200.   )
  201. )
  202.  
  203. (script-fu-register "script-fu-text-circle"
  204.   _"Text C_ircle..."
  205.   _"Create a logo by rendering the specified text along the perimeter of a circle"
  206.   "Shuji Narazaki <narazaki@gimp.org>"
  207.   "Shuji Narazaki"
  208.   "1997-1998"
  209.   ""
  210.   SF-STRING     _"Text" "The GNU Image Manipulation Program Version 2.0 "
  211.   SF-ADJUSTMENT _"Radius"             '(80 1 8000 1 1 0 1)
  212.   SF-ADJUSTMENT _"Start angle"        '(0 -180 180 1 1 0 1)
  213.   SF-ADJUSTMENT _"Fill angle"         '(360 -360 360 1 1 0 1)
  214.   SF-ADJUSTMENT _"Font size (pixels)" '(18 1 1000 1 1 0 1)
  215.   SF-TOGGLE     _"Antialias"          TRUE
  216.   SF-FONT       _"Font"               "Sans"
  217. )
  218.  
  219. (script-fu-menu-register "script-fu-text-circle"
  220.                          "<Image>/File/Create/Logos")
  221.